global askedToKeepChartin, usrName, pswd, oldDepth, forewarned, registered
cursor(4)
if ((the stageBottom - the stageTop) < 476) or ((the stageRight - the stageLeft) < 630) then
alert("The display must be set to 640 X 480 resolution or greater.")
quit()
end if
if the colorDepth < 8 then
set the colorDepth to 8
end if
if the colorDepth < 8 then
alert("The display is not set to use 8 bit (256) color or greater. Charting Coach graphics will be distorted. Please readjust the computer display bit depth.")
end if
puppetVisible(1, 48, 1)
puppetStatus(1, 48, 0)
initVars()
cursor(4)
set the keyDownScript to "if the key = return then dontPassEvent"
getTheDate()
setupPrint()
if the machineType = 256 then
openXLib(the pathName & "MovUtils.DLL")
openXLib(the pathName & "fileIO.DLL")
end if
put " " into field "userName"
put " " into field "passWord"
put EMPTY into field "comments"
put EMPTY into field "advice"
put EMPTY into field "basis"
put " " into field "problem"
readUserNames()
if (registered = "BVM") or (the frame = label("frontPage")) then
go("login")
else
go("register")
end if
cursor(0)
end
on getTheDate
global theDate
if the machineType = 256 then
openXLib("getdate.dll")
set getDateXObj to getDate(mnew)
set theDate to getDateXObj(mGetDate)
getDateXObj(mdispose)
closeXLib("getdate.dll")
else
set theDate to datePack("getMachineDate")
end if
set theDate to string(theDate)
set theDate to string(chars(theDate, 5, 6) & "/" & chars(theDate, 7, 8) & "/" & chars(theDate, 3, 4))
end
on register
global registered
set x to the text of field "register"
put EMPTY into field "register"
if (the number of chars in x = 10) and (x contains "B") and (x contains "V") and (x contains "M") and (x contains "3") then
go("login")
cursor(0)
set registered to "BVM"
resetUserNames()
else
cursor(0)
alert("Improper registration number.")
put EMPTY into field "register"
end if
end
on setupPrint
global printer, gPropFont, gMonoFont
if the machineType = 256 then
set gPropFont to "arial"
set gMonoFont to "courier new"
else
set gPropFont to "helvetica"
set gMonoFont to "courier"
end if
if not objectp(printer) then
if the machineType = 256 then
openXLib(the pathName & "pmatic.dll")
end if
set printer to PrintOMatic(mnew)
if objectp(printer) then
if the machineType = 256 then
printer(mRegister, "10090739-939")
else
printer(mRegister, "11091751-406")
end if
end if
end if
end
on stopMovie
global printer, oldDepth
go("leaving")
set the colorDepth to oldDepth
if objectp(printer) then
printer(mdispose)
end if
if the machineType = 256 then
closeXLib(the pathName & "pmatic.dll")
closeXLib(the pathName & "MovUtils.DLL")
closeXLib(the pathName & "fileIO.DLL")
end if
end
on login
global usrName, pswd, cycleNo, userNo, currentCycleNo
set checkuser to word 1 of the text of field "username"
set checkpass to word 1 of the text of field "password"
set usrOK to 0
set pssOK to 0
set loginok to 0
set x to count(usrName)
if x > 0 then
repeat with i = 1 to x
if checkuser = getAt(usrName, i) then
set usrOK to 1
if checkpass = getAt(pswd, i) then
set userNo to i
set currentCycleNo to getAt(cycleNo, userNo)
readCycleInfo()
prepfrontpage()
cursor(0)
exit
next repeat
end if
cursor(0)
alert("Login Failed. Please enter a correct password.")
go("loginPswd")
exit
end if
end repeat
else
cursor(0)
alert("Login Failed. If this is the first time you're using this program, press the New User button.")
set usrOK to 1
end if
cursor(0)
if usrOK = 0 then
alert("Login Failed. Please enter a correct username.")
end if
go("login")
cursor(0)
end
on checkPsWrd
global pswd, userNo
if word 1 of the text of field "Password" = getAt(pswd, userNo) then
go("ChngPswrd")
cursor(0)
else
cursor(0)
alert("Incorrect Password. Please try again.")
put EMPTY into field "Password"
end if
end
on newPswd
global candidatePswd
cursor(0)
set checkPswd to the text of field "password"
set the text of field "password" to EMPTY
if the number of words in checkPswd > 1 then
alert("Please use a one word password without spaces.")
else
if the number of words in checkPswd = 1 then
set candidatePswd to word 1 of checkPswd
go("ConfirmNewPswd")
else
if the number of words in checkPswd = 0 then
go("ConfirmNoPswd")
end if
end if
end if
end
on confirmPswd
global pswd, usrName, candidateUserName, candidatePswd
set checkPswd to word 1 of the text of field "password"
if checkPswd = candidatePswd then
append(usrName, capitalizeIT(candidateUserName))
append(pswd, candidatePswd)
confirmOK()
else
cursor(0)
alert("Confirmation Failed. Re-enter your password.")
go("psWrd")
end if
end
on changePswd
global pswd, checkPswd
set checkPswd to the text of field "password"
set isbad to 0
if the number of words in checkPswd > 1 then
cursor(0)
alert("Please do not use blank spaces in your password.")
set NewWord to numToChar(x - 32) & chars(wordUp, 2, 30)
return NewWord
else
return wordUp
end if
end
on newuser
global candidateUserName
if checkUserName(the text of field "username") then
set candidateUserName to word 1 of field "userName"
go("psWrd")
cursor(0)
end if
end
on newUserName
global userNo, usrName
set newName to word 1 of field "username"
if checkUserName(newName) then
setAt(usrName, userNo, capitalizeIT(newName))
resetUserNames()
prepfrontpage()
end if
cursor(0)
end
on checkUserName checkuser
global usrName
if (the number of words in checkuser > 1) or (the number of words in checkuser = 0) then
cursor(0)
alert("Please enter a one word username.")
set the text of field "username" to EMPTY
return 0
else
set x to count(usrName)
set checkuser to word 1 of checkuser
repeat with i = 1 to x
if checkuser = getAt(usrName, i) then
cursor(0)
alert("Sorry. There is already a username similar to this one. Please enter a different username.")
set the text of field "username" to EMPTY
return 0
set i to x + 1
end if
end repeat
end if
return 1
end
on getSystemPath
if objectp(utilObj) then
utilObj(mdispose)
end if
if the machineType = 256 then
set utilObj to MovUtils(mnew)
else
set utilObj to MovieUtilities(mnew)
end if
if objectp(utilObj) then
set systemPath to utilObj(mGetSystemPath)
if the machineType = 256 then
set prefLOC to systemPath & "\"
else
set prefLOC to systemPath & "Preferences:"
end if
utilObj(mdispose)
return prefLOC
else
cursor(0)
alert("Sorry...Fatal Error: Can't write to System Folder!")
end if
end
on makeAlist dataList
set x to the number of chars in dataList - 2
set the itemDelimiter to ","
set newList to []
set templist to chars(dataList, 2, x)
set x to the number of items in templist
repeat with i = 1 to x
if integerp(integer(item i of templist)) then
append(newList, integer(item i of templist))
next repeat
end if
append(newList, item i of templist)
end repeat
if not integerp(max(newList)) then
set newList to []
end if
return newList
end
on StartNewCycle
global cycleNo, userNo, currentCycleNo, bioInfo
cursor(4)
puppetStatus(23, 48, 0)
if not anyFertileDay() and (count(stamp) > 12) then
setAnovul()
cursor(0)
alert("The previous cycle had no peak. The cycle was either not charted in full, not charted correctly, or the cycle was ANOVULATORY.")
end if
set oldBioInfo to bioInfo
initVars()
set bioInfo to oldBioInfo
set x to getAt(cycleNo, userNo) + 1
setAt(cycleNo, userNo, x)
set currentCycleNo to x
resetUserNames()
writecycleinfo()
cursor(0)
alert("The previous chart was archived. A new chart has been created for cycle #" && x & "." & RETURN & RETURN & "You must update your Biographical Data for the New Cycle.")
setUpBiodata()
end
on makeCorrection
puppetSprite(7, 1)
set the visible of sprite 7 to 1
puppetSprite(7, 0)
updateStage()
repeat with i = 13 to 48
set the cursor of sprite i to [the number of member "eraser", the number of member "eraser"]
end repeat
end
on killcorrection
repeat with i = 13 to 48
set the cursor of sprite i to 0
end repeat
end
on roundUpAlways x
set framelocation to string(x)
set numberLoc to offset(".", framelocation) - 1
return chars(framelocation, 1, numberLoc)
end
on positionNob
global firstMonthlyDay, stamp
set MaxScroll to float(count(stamp))
if firstMonthlyDay = 1 then
set NewPosition to 221
else
if (firstMonthlyDay + 11) = MaxScroll then
set NewPosition to 500
else
set NewPosition to ((firstMonthlyDay + 11) / MaxScroll * 279) + 220
end if
end if
set the locH of sprite 11 to NewPosition
updateStage()
end
on prepBioDataSummary
global bioInfo, usrName, userNo
put " " into field "biodatasummary"
if max(bioInfo) = 15 then
if min(bioInfo) <> 1 then
put the text of field "profile 15" & RETURN & RETURN into field "bioDataSummary"
end if
set x to count(bioInfo)
repeat with i = 1 to x - 1
put i & ") " after field "biodataSummary"
if (getAt(bioInfo, i) = 13) or (getAt(bioInfo, i) = 8) or (getAt(bioInfo, i) = 2) or (getAt(bioInfo, i) = 12) then
put the text of field ("profile 15-" & getAt(bioInfo, i)) & RETURN & RETURN after field "biodataSummary"
next repeat
end if
put the text of field ("profile" && getAt(bioInfo, i)) & RETURN & RETURN after field "biodataSummary"
end repeat
else
put the text of field "profile 14" & RETURN & RETURN into field "bioDataSummary"
set x to count(bioInfo)
repeat with i = 1 to x - 1
put i & ") " after field "biodataSummary"
if (getAt(bioInfo, i) = 13) or (getAt(bioInfo, i) = 8) or (getAt(bioInfo, i) = 2) or (getAt(bioInfo, i) = 12) then
put the text of field ("profile 14-" & getAt(bioInfo, i)) & RETURN & RETURN after field "biodataSummary"
next repeat
end if
put the text of field ("profile" && getAt(bioInfo, i)) & RETURN & RETURN after field "biodataSummary"
end repeat
end if
put "Initial advice for " & getAt(usrName, userNo) & RETURN & RETURN before field "bioDataSummary"
